home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacHaskell 2.2 / tdecl / deriving.scm < prev    next >
Encoding:
Text File  |  1994-09-27  |  1.2 KB  |  33 lines  |  [TEXT/CCL2]
  1. ;;;
  2. ;;; This processes the deriving declaration
  3. ;;;
  4.  
  5. (predefine (scope-single-fun-def sfd env lhs1))
  6.  
  7. (define (deriving-decl->deriving decl)
  8.   (let* ((simple (deriving-decl-simple decl))
  9.      (di (tycon-def simple))
  10.      (c (deriving-decl-constraints decl))
  11.      (tyvars (simple-tyvar-list simple))
  12.      (i-decls (deriving-decl-inst-decls decl)))
  13.     (cond ((or (null? tyvars) (not (null? (cdr tyvars))))
  14.        (phase-error 'bad-deriving
  15.              "Deriving clause must have one exactly one parameter"))
  16.       (else
  17.        (resolve-signature-aux tyvars c)
  18.        (dolist (constraint c)
  19.              (push (context-class constraint) (deriving-preconditions di)))
  20.        (setf (deriving-tyvar di) (car tyvars))
  21.        (dolist (d i-decls)
  22.          (with-slots instance-decl (context class simple decls) d
  23.            (when (not (and (tyvar? simple)
  24.                    (eq? (tyvar-name simple) (car tyvars))))
  25.           (phase-error 'bad-deriving
  26.             "Instance declaration must refer to type ~A" (car tyvars)))
  27.            (resolve-signature-aux tyvars context)
  28.            (resolve-class class)
  29.            (dolist (d1 decls)
  30.          (dolist (sfd (valdef-definitions d1))
  31.              (scope-single-fun-def sfd '() (valdef-lhs d1))))))
  32.        (setf (deriving-instances di) i-decls)))))
  33.